home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmOrientationImage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  11.5 KB  |  372 lines

  1. {******************************************************************************}
  2. {                                                                              }
  3. {                      GmOrientationImage.pas v2.61 Pro                        }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmOrientationImage;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, GmTypes,
  19.   GmPreview, Buttons, GmConst;
  20.  
  21.   {$I GMPS.INC}
  22.  
  23. type
  24.   TGmOrientationPage = class(TGmPaperImage)
  25.   private
  26.     FOrientation: TGmOrientation;
  27.     FShowHeaderFooter: Boolean;
  28.     procedure SetOrientation(AOrientation: TGmOrientation);
  29.     procedure DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  30.   protected
  31.     procedure Paint; override;
  32.   public
  33.     constructor Create(AOwner: TComponent); override;
  34.     destructor Destroy; override;
  35.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  36.   end;
  37.  
  38.   TGmOrientationImage = class(TWinControl)
  39.   private
  40.     FBorderStyle: TBorderStyle;
  41.     FBtnPortrait: TSpeedButton;
  42.     FBtnLandscape: TSpeedButton;
  43.     FOrientation: TGmOrientation;
  44.     FPreview: TGmPreview;
  45.     FPageImage: TGmOrientationPage;
  46.     FShowButtons: Boolean;
  47.     FShowHeaderFooter: Boolean;
  48.     // events...
  49.     FOnChanging: TNotifyEvent;
  50.     FOnClickPortrait: TNotifyEvent;
  51.     FOnClickLandscape: TNotifyEvent;
  52.  
  53.     function GetAbout: string;
  54.     function GetVersion: Extended;
  55.     procedure SetAbout(const AValue: string);
  56.  
  57.     procedure BtnClick(Sender: TObject);
  58.     procedure SetGmPreview(APreview: TGmPreview);
  59.     procedure SetOrientation(AOrientation: TGmOrientation);
  60.     procedure SetShadow(AShadow: TGmShadow);
  61.     procedure SetShowButtons(AValue: Boolean);
  62.     procedure SetShowHeaderFooter(AValue: Boolean);
  63.     function GetShadow: TGmShadow;
  64.     procedure SetBorderStyle(const Value: TBorderStyle);
  65.  
  66.     { Private declarations }
  67.   protected
  68.     procedure CreateParams(var Params: TCreateParams); override;
  69.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  70.     // update messages...
  71.     procedure OrientationChanged(var Message: TMessage); message GM_ORIENTATION_CHANGED;
  72.     procedure ComponentResize(var Message: TMessage); message WM_SIZE;
  73.     { Protected declarations }
  74.   public
  75.     constructor Create(AOwner: TComponent); override;
  76.     destructor Destroy; override;
  77.     property Version: Extended read GetVersion;
  78.     { Public declarations }
  79.   published
  80.     property About: string read GetAbout write SetAbout;
  81.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  82.     property Color default clGray;
  83.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  84.     property ParentColor;
  85.     property Preview: TGmPreview read FPreview write SetGmPreview;
  86.     property ShowHint;
  87.     property Shadow: TGmShadow read GetShadow write SetShadow;
  88.     property ShowButtons: Boolean read FShowButtons write SetShowButtons default True;
  89.     property ShowHeaderFooter: Boolean read FShowHeaderFooter write SetShowHeaderFooter default True;
  90.     property Visible;
  91.     // events
  92.     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  93.     property OnClickPortrait: TNotifyEvent read FOnClickPortrait write FOnClickPortrait;
  94.     property OnClickLandscape: TNotifyEvent read FOnClickLandscape write FOnClickLandscape;
  95.     { Published declarations }
  96.   end;
  97.  
  98. implementation
  99.  
  100. {$R OrienRes.RES}
  101.  
  102. //------------------------------------------------------------------------------
  103.  
  104. procedure TGmOrientationPage.SetOrientation(AOrientation: TGmOrientation);
  105. var
  106.   TempVal: integer;
  107. begin
  108.   // set the orientation of the TGmOrientationImage page...
  109.   if FOrientation <> AOrientation then
  110.   begin
  111.     FOrientation := AOrientation;
  112.     // resize page...
  113.     TempVal := Width;
  114.     Width := Height;
  115.     Height := TempVal;
  116.     Top := (TWinControl(Owner).Height - Height) div 2;
  117.     Invalidate;
  118.   end;
  119. end;
  120.  
  121. procedure TGmOrientationPage.DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  122. begin
  123.   // draw a header and footer on the page image...
  124.   if FShowHeaderFooter then
  125.   begin
  126.     Canvas.Pen.Color := $00777777;
  127.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Top+Border)   , Point(AArea.Right-Border, AArea.Top+Border)]);
  128.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Bottom-Border), Point(AArea.Right-Border, AArea.Bottom-Border)]);
  129.   end;
  130. end;
  131.  
  132. constructor TGmOrientationPage.Create(AOwner: TComponent);
  133. begin
  134.   inherited Create(AOwner);
  135.   Shadow := TGmShadow.Create;
  136.   Gutter := 5;
  137. end;
  138.  
  139. destructor TGmOrientationPage.Destroy;
  140. begin
  141.   Shadow.Free;
  142.   inherited Destroy;
  143. end;
  144.  
  145. procedure TGmOrientationPage.Paint;
  146. var
  147.   AChar: Char;
  148.   TextPos: TPoint;
  149.   PageArea: TRect;
  150. begin
  151.   // paint the page...
  152.   inherited;
  153.   with Canvas do
  154.   begin
  155.     Pen.Style := psSolid;
  156.     PageArea := PageRect;
  157.     DrawHeaderFooter(Canvas, PageArea, 6);
  158.     Font.Name := 'Times New Roman';
  159.     Font.Size := 16;
  160.     Font.Color := clSilver;
  161.     Brush.Style := bsClear;
  162.     if FOrientation = gmPortrait then AChar := 'P' else AChar := 'L';
  163.     TextPos.x := (Width - TextWidth(AChar)) div 2;
  164.     TextPos.y := (Height - TextHeight(AChar)) div 2;
  165.     TextOut(TextPos.x, TextPos.y ,AChar);
  166.   end;
  167. end;
  168.  
  169. //------------------------------------------------------------------------------
  170.  
  171.  
  172. constructor TGmOrientationImage.Create(AOwner: TComponent);
  173. begin
  174.   inherited Create(AOwner);
  175.   FBorderStyle := bsSingle;
  176.   Color := clGray;
  177.   Width := 121;
  178.   Height := 89;
  179.   FPageImage := TGmOrientationPage.Create(Self);
  180.   FPageImage.FShowHeaderFooter := True;
  181.   FShowHeaderFooter := True;
  182.   with FPageImage do
  183.   begin
  184.     Left := 40;
  185.     Width := 50;
  186.     Height := 65;
  187.     Shadow.Width := 2;
  188.     Parent := Self;
  189.   end;
  190.   FShowButtons := False;
  191.   Orientation := gmPortrait;
  192.   SetShowButtons(True);
  193. end;
  194.  
  195. destructor TGmOrientationImage.Destroy;
  196. begin
  197.   // free the TGmOrientationImage and destroy...
  198.   if Assigned(FPreview) then FPreview.RemoveAssociatedComponent(Self);
  199.   if Assigned(FBtnPortrait) then FBtnPortrait.Free;
  200.   if Assigned(FBtnLandscape) then FBtnLandscape.Free;
  201.   FPageImage.Free;
  202.   inherited Destroy;
  203. end;
  204.  
  205. function TGmOrientationImage.GetAbout: string;
  206. begin
  207.   Result := Self.ClassName+' v'+FloatToStr(GetVersion);
  208. end;
  209.  
  210. function TGmOrientationImage.GetVersion: Extended;
  211. begin
  212.   Result := SUITE_VERSION;
  213. end;
  214.  
  215. procedure TGmOrientationImage.SetAbout(const AValue: string);
  216. begin
  217.   // does nothing.
  218. end;
  219.  
  220. procedure TGmOrientationImage.CreateParams(var Params: TCreateParams);
  221. const
  222.   BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  223. begin
  224.   inherited CreateParams(Params);
  225.   with Params do
  226.   begin
  227.     Style := Style or BorderStyles[FBorderStyle];
  228.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  229.     begin
  230.       Style := Style and not WS_BORDER;
  231.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  232.     end;
  233.   end;
  234. end;
  235.  
  236. procedure TGmOrientationImage.Notification(AComponent: TComponent; Operation: TOperation);
  237. begin
  238.   inherited Notification(AComponent, Operation);
  239.   if (Operation = opRemove) and (AComponent = FPreview) then
  240.     FPreview := nil;
  241. end;
  242.  
  243. procedure TGmOrientationImage.OrientationChanged(var Message: TMessage);
  244. begin
  245.   // keep the orientation in syncronization with the TGmPreview...
  246.   Orientation := FPreview.Orientation;
  247. end;
  248.  
  249. procedure TGmOrientationImage.ComponentResize(var Message: TMessage);
  250. begin
  251.   FBtnPortrait.SetBounds((Width div 2) - 44, (Height div 2) - 26, FBtnPortrait.Width, FBtnPortrait.Height);
  252.   FBtnLandscape.SetBounds((Width div 2) - 44, (Height div 2) + 2, FBtnLandscape.Width, FBtnLandscape.Height);
  253.   FPageImage.SetBounds((Width div 2) -14, (Height div 2) - 32, FPageImage.Width, FPageImage.Height);
  254. end;
  255.  
  256. procedure TGmOrientationImage.BtnClick(Sender: TObject);
  257. begin
  258.   // call the button events when clicked...
  259.   if Assigned(FOnChanging) then FOnChanging(Self);
  260.   if (Sender = FBtnPortrait) and (Orientation <> gmPortrait) then
  261.   begin
  262.     if Assigned(FPreview) then FPreview.Orientation := gmPortrait;
  263.     if Assigned(FOnClickPortrait) then FOnClickPortrait(Self);
  264.   end
  265.   else
  266.   if (Sender = FBtnLandscape) and  (Orientation <> gmLandscape) then
  267.   begin
  268.     if Assigned(FPreview) then FPreview.Orientation := gmLandscape;
  269.     if Assigned(FOnClickLandscape) then FOnClickLandscape(Self);
  270.   end;
  271. end;
  272.  
  273. procedure TGmOrientationImage.SetGmPreview(APreview: TGmPreview);
  274. begin
  275.   // assign the Preview property to a TGmPreview...
  276.   if Assigned(FPreview) then FPreview.RemoveAssociatedComponent(Self);
  277.   FPreview := APreview;
  278.   if Assigned(FPreview) then
  279.   begin
  280.     FPreview.AddAssociatedComponent(Self);
  281.     Orientation := FPreview.Orientation;
  282.   end;
  283. end;
  284.  
  285. procedure TGmOrientationImage.SetOrientation(AOrientation: TGmOrientation);
  286. begin
  287.   // change the orientation...
  288.   FOrientation := AOrientation;
  289.   FPageImage.Orientation := AOrientation;
  290.   // select the correct button...
  291.   if FShowButtons then
  292.   begin
  293.     FBtnPortrait.Down := AOrientation = gmPortrait;
  294.     FBtnLandscape.Down := AOrientation = gmLandscape;
  295.   end;
  296.   if Assigned(FPreview) then FPreview.Orientation := AOrientation;
  297.   //Invalidate;
  298. end;
  299.  
  300. procedure TGmOrientationImage.SetShadow(AShadow: TGmShadow);
  301. begin
  302.   FPageImage.Shadow := AShadow;
  303.   FPageImage.Invalidate;
  304. end;
  305.  
  306. procedure TGmOrientationImage.SetShowButtons(AValue: Boolean);
  307. begin
  308.   // show or hide the buttons...
  309.   if FShowButtons <> AValue then
  310.   begin
  311.     if AValue = True then
  312.     begin
  313.       FPageImage.Left := 40;
  314.       FBtnPortrait := TSpeedButton.Create(Self);
  315.       with FBtnPortrait do
  316.       begin
  317.         Top := 6;
  318.         Left := 8;
  319.         Glyph.LoadFromResourceName(HInstance, 'BTNPORT');
  320.         GroupIndex := 1;
  321.         Down := True;
  322.         OnClick := BtnClick;
  323.       end;
  324.       FBtnLandscape := TSpeedButton.Create(Self);
  325.       with FBtnLandscape do
  326.       begin
  327.         Top := 34;
  328.         Left := 8;
  329.         Glyph.LoadFromResourceName(HInstance, 'BTNLAND');
  330.         GroupIndex := 1;
  331.         OnClick := BtnClick;
  332.       end;
  333.       FBtnPortrait.Parent := Self;
  334.       FBtnLandscape.Parent := Self;
  335.     end
  336.     else
  337.     begin
  338.       FPageImage.Left := 4;
  339.       FBtnPortrait.Free;
  340.       FBtnLandscape.Free;
  341.       FBtnPortrait := nil;
  342.       FBtnLandscape := nil;
  343.     end;
  344.     FShowButtons := AValue;
  345.   end;
  346. end;
  347.  
  348. procedure TGmOrientationImage.SetShowHeaderFooter(AValue: Boolean);
  349. begin
  350.   // show or hide the header/footer...
  351.   FShowHeaderFooter := AValue;
  352.   FPageImage.FShowHeaderFooter := AValue;
  353.   FPageImage.Repaint;
  354. end;
  355.  
  356. function TGmOrientationImage.GetShadow: TGmShadow;
  357. begin
  358.   // return the TGmShadow object...
  359.   Result := FPageImage.Shadow;
  360. end;
  361.  
  362. procedure TGmOrientationImage.SetBorderStyle(const Value: TBorderStyle);
  363. begin
  364.   if FBorderStyle <> Value then
  365.   begin
  366.     FBorderStyle := Value;
  367.     RecreateWnd;
  368.   end;
  369. end;
  370.  
  371. end.
  372.